{-# LANGUAGE DeriveDataTypeable #-}
----------------------------------------------------------------
--                                                            --
-- Module      :  LLVM.Code.ParamAttrs                        --
-- License     :  GPL3                                        --
-- Mantainer   :  Mikhail Belyaev                             --
--                                                            --
----------------------------------------------------------------

module LLVM.Code.ParamAttrs where

import Data.Generics(Typeable, Data)

import LLVM.Util

import LLVM.Parser.Record.Record
       (extrudeCustomRecords, RawBlock(..), extrudeData, BlockHeader(..),
        BlockType(..), recordAsList, RecordType, fromRawRecord)
import Data.List (genericLength)
import Data.BitField (BitField(..))
--The ENTRY record (code 1) contains an even number of values describing a unique set of function parameter attributes. Each paramidx value indicates which set of attributes is represented, with 0 representing the return value attributes, 0xFFFFFFFF representing function attributes, and other values representing 1-based function parameters. Each attr value is a bitmap with the following interpretation:
--
--    * bit 0: zeroext
--    * bit 1: signext
--    * bit 2: noreturn
--    * bit 3: inreg
--    * bit 4: sret
--    * bit 5: nounwind
--    * bit 6: noalias
--    * bit 7: byval
--    * bit 8: nest
--    * bit 9: readnone
--    * bit 10: readonly
--    * bit 11: noinline
--    * bit 12: alwaysinline
--    * bit 13: optsize
--    * bit 14: ssp
--    * bit 15: sspreq
--    * bits 16–31: align n
--    * bit 32: nocapture
--    * bit 33: noredzone
--    * bit 34: noimplicitfloat
--    * bit 35: naked
--    * bit 36: inlinehint
--    * bits 37–39: alignstack n, represented as the logarithm base 2 of the requested alignment, plus 1
data ParamIndex = RetValueIndex | FunctionIndex | ParamIndex Integer deriving (Eq,Show,Typeable,Data)

integerToParamIndex :: Integer -> ParamIndex
integerToParamIndex 0 = RetValueIndex
integerToParamIndex 0xFFFFFFFF = FunctionIndex
integerToParamIndex x = ParamIndex (x-1)

data ParamEntry = ParamEntry {
                    functionAttr :: ParamAttributes,
                    returnValueAttr :: ParamAttributes,
                    paramAttrs :: [(Integer, ParamAttributes)]
                  }deriving (Show,Eq,Typeable,Data)

emptyPE :: ParamEntry
emptyPE = ParamEntry emptyPA emptyPA []

data ParamAttributes = ParamAttributes {
                        zeroext :: Bool,
                        signext :: Bool,
                        noreturn :: Bool,
                        inreg :: Bool,
                        sret :: Bool,
                        nounwind :: Bool,
                        noalias :: Bool,
                        byval :: Bool,
                        nest :: Bool,
                        readnone :: Bool,
                        readonly :: Bool,
                        noinline :: Bool,
                        alwaysinline :: Bool,
                        optsize :: Bool,
                        ssp :: Bool,
                        sspreq :: Bool,
                        align :: Integer,
                        nocapture :: Bool,
                        noredzone :: Bool,
                        noimplicitfloat :: Bool,
                        naked :: Bool,
                        inlinehint :: Bool,
                        alignstack :: Integer
                     } deriving (Show,Eq,Typeable,Data)

instance BitField ParamAttributes where
        getbfBit 0  = zeroext
        getbfBit 1  = signext
        getbfBit 2  = noreturn
        getbfBit 3  = inreg
        getbfBit 4  = sret
        getbfBit 5  = nounwind
        getbfBit 6  = noalias
        getbfBit 7  = byval
        getbfBit 8  = nest
        getbfBit 9  = readnone
        getbfBit 10 = readonly
        getbfBit 11 = noinline
        getbfBit 12 = alwaysinline
        getbfBit 13 = optsize
        getbfBit 14 = ssp
        getbfBit 15 = sspreq
        getbfBit x | minx <= x && maxx >= x = \v -> getbfBit (x-minx) $ align v
                   where minx = 16;maxx = 31
        getbfBit 32 = nocapture
        getbfBit 33 = noredzone
        getbfBit 34 = noimplicitfloat
        getbfBit 35 = naked
        getbfBit 36 = inlinehint
        getbfBit x | minx <= x && maxx >= x = \v -> getbfBit (x-minx) $ alignstack v
                   where minx = 37;maxx = 39
        getbfBit _  = const False
        setbfBit 0  pa v = pa { zeroext = v }
        setbfBit 1  pa v = pa { signext = v }
        setbfBit 2  pa v = pa { noreturn = v }
        setbfBit 3  pa v = pa { inreg = v }
        setbfBit 4  pa v = pa { sret = v }
        setbfBit 5  pa v = pa { nounwind = v }
        setbfBit 6  pa v = pa { noalias = v }
        setbfBit 7  pa v = pa { byval = v }
        setbfBit 8  pa v = pa { nest = v }
        setbfBit 9  pa v = pa { readnone = v }
        setbfBit 10 pa v = pa { readonly = v }
        setbfBit 11 pa v = pa { noinline = v }
        setbfBit 12 pa v = pa { alwaysinline = v }
        setbfBit 13 pa v = pa { optsize = v }
        setbfBit 14 pa v = pa { ssp = v }
        setbfBit 15 pa v = pa { sspreq = v }
        setbfBit x  pa v | minx <= x && maxx >= x = pa { align = setbfBit (x-minx) (pa.$align) v }
                          where (minx,maxx) = (16,31)
        setbfBit 32 pa v = pa { nocapture = v }
        setbfBit 33 pa v = pa { noredzone = v }
        setbfBit 34 pa v = pa { noimplicitfloat = v }
        setbfBit 35 pa v = pa { naked = v }
        setbfBit 36 pa v = pa { inlinehint = v }
        setbfBit x  pa v | minx <= x && maxx >= x = pa { alignstack = setbfBit (x-minx) (pa.$alignstack) v }
                          where (minx,maxx) = (37,39)
        setbfBit _  pa _ = pa



emptyPA :: ParamAttributes
emptyPA = ParamAttributes False False False False False False False False False False False False
             False False False False 0 False False False False False 0

integerToParamAttr :: Integer -> ParamAttributes
integerToParamAttr i = mapBits (0,40) i emptyPA

instance RecordType ParamEntry where
    fromRawRecord rr = case (recordAsList rr) of
                            (_:1:rest) -> let
                                             attrlength = genericLength rest `div` 2
                                             izip (a:b:tl) = (a,b):(izip tl)
                                             izip _ = []
                                             irest = izip rest
                                             attrmap =
                                                map (\(i,p) -> (i,integerToParamAttr p) ) irest
                                         in Just $
                                                ParamEntry
                                                    (lookup 0xFFFFFFFF attrmap ?? emptyPA)
                                                    (lookup 0          attrmap ?? emptyPA)
                                                    (filter (\(x,_) -> x > 0 && x /= 0xFFFFFFFF) attrmap)
                            otherwise -> Nothing

newtype ParamBlock = ParamBlock { pbAsList :: [ParamEntry] } deriving (Show,Eq,Typeable,Data)

instance BlockType ParamBlock where
    fromRawBlock rb | rb.$header.$blockId == 9 = Just $ ParamBlock $ rb.$extrudeCustomRecords
    fromRawBlock _ = Nothing

emptyPB = ParamBlock []


